unit KeyboardUnit;

interface

uses Windows, Messages, Classes, Forms, StdCtrls, SysUtils, RawInput_h;

type
  TMouseEvents = class(TScrollingWinControl)
  private
    FSkipList: TList;
    RAWInputDevice: packed array [0..0] of TRAWInputDevice;
    procedure MSGRawInput(var MSG: TMessage); message WM_INPUT;
  public
    Lock: Boolean;
    waitPoint: TPoint;
    oldPos: TPoint;
    tempMove: TPoint;

    procedure Open;
    procedure AddSkipMessage(msg: Cardinal);
    function SkipListCount: Integer;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure UpdateKeyboardState;

function IsKeyPressed(nVirtKey: Integer): Boolean;
function IsKeyDown(nVirtKey: Integer): Boolean;
function IsKeyUp(nVirtKey: Integer): Boolean;

function IsShortCutDown(nShortCut: TShortCut): Boolean;

implementation

uses Controls;

var
  KeyState: array[0..255] of Byte;
  _KeyDown: array[0..255] of Boolean;
  _KeyUp: array[0..255] of Boolean;
  mask: TShortCut;

  procedure UpdateKeyState(nKey: Integer);
  var
    state: WORD;
    oldState: Byte;
  begin
    state := GetAsyncKeyState(nKey);
    oldState := KeyState[nKey];
    KeyState[nKey] := state shr 15;
    if (oldState = 0) and (KeyState[nKey] = 1) then begin
      _KeyDown[nKey] := True;
      _KeyUp[nKey] := False;
    end;
    if (oldState = 1) and (KeyState[nKey] = 0) then begin
      _KeyDown[nKey] := False;
      _KeyUp[nKey] := True;
    end;
  end;

procedure UpdateKeyboardState;
var
  nKey: Byte;
  state: WORD;
begin
  UpdateKeyState(VK_CONTROL);
  UpdateKeyState(VK_MENU);
  UpdateKeyState(VK_SHIFT);

  mask := scNone;
  for nKey := 0 to 255 do begin
    case nKey of
      VK_CONTROL, VK_LCONTROL, VK_RCONTROL,
      VK_SHIFT, VK_LSHIFT, VK_RSHIFT,
      VK_MENU, VK_LMENU, VK_RMENU: ;
      VK_LBUTTON, VK_RBUTTON, VK_MBUTTON: begin
        // process from TMouseEvents
      end
      else begin
        UpdateKeyState(nKey);
        if KeyState[nKey] = 1 then
          mask := nKey;
      end;
    end;
  end;

  if KeyState[VK_CONTROL] = 1 then mask := mask or scCtrl;
  if KeyState[VK_SHIFT] = 1 then mask := mask or scShift;
  if KeyState[VK_MENU] = 1 then mask := mask or scAlt;
end;

function IsKeyPressed(nVirtKey: Integer): Boolean;
begin
  Result := KeyState[nVirtKey] = 1;
end;

function IsShortCutDown(nShortCut: TShortCut): Boolean;
begin
  Result := (nShortCut > 0) and (nShortCut = mask);
end;

function IsKeyDown(nVirtKey: Integer): Boolean;
begin
  Result := _KeyDown[nVirtKey];
  _KeyDown[nVirtKey] := False;
end;

function IsKeyUp(nVirtKey: Integer): Boolean;
begin
  Result := _KeyUp[nVirtKey];
  _KeyUp[nVirtKey] := False;
end;

{ TMouseEvents }

procedure TMouseEvents.AddSkipMessage(msg: Cardinal);
begin
  FSkipList.Add(Pointer(msg));
end;

constructor TMouseEvents.Create(AOwner: TComponent);
begin
  inherited;
  Lock := False;
  FSkipList := TList.Create;

  tempMove.X := 0;
  tempMove.Y := 0;
end;

destructor TMouseEvents.Destroy;
begin
  RAWInputDevice[0].dwFlags     := RIDEV_REMOVE;
  RegisterRawInputDevices(@RAWInputDevice, 1, SizeOf(TRAWInputDevice));
  FSkipList.Free;
  inherited;
end;

procedure TMouseEvents.MSGRawInput(var MSG: TMessage);

  function IsEmpty(const p: TPoint): Boolean;
  begin
    Result := (p.X = 0) and (p.Y = 0);
  end;

  procedure ButtonDown(nVirtKey: Integer);
  begin
    _KeyDown[nVirtKey] := True;
    KeyState[nVirtKey] := 1;
    _KeyUp[nVirtKey] := False;
  end;

  procedure ButtonUp(nVirtKey: Integer);
  begin
    _KeyDown[nVirtKey] := False;
    KeyState[nVirtKey] := 0;
    _KeyUp[nVirtKey] := True;
  end;

  function CheckButton(usButtonFlag, downMask, upMask, nVirtKey: Integer): Boolean;
  begin
    if (usButtonFlag and downMask) = downMask then begin
      ButtonDown(nVirtKey);
      Result := True;
    end
    else if (usButtonFlag and upMask) = upMask then begin
      ButtonUp(nVirtKey);
      Result := True;
    end
    else Result := False;
  end;

type
  TButtonConsts = (bcMaskButtonDown, bcMaskButtonUp, bcVirtKey);

const
  buttons: array[1..3, TButtonConsts] of Integer = (
    (RI_MOUSE_LEFT_BUTTON_DOWN, RI_MOUSE_LEFT_BUTTON_UP, VK_LBUTTON),
    (RI_MOUSE_RIGHT_BUTTON_DOWN, RI_MOUSE_RIGHT_BUTTON_UP, VK_RBUTTON),
    (RI_MOUSE_MIDDLE_BUTTON_DOWN, RI_MOUSE_MIDDLE_BUTTON_UP, VK_MBUTTON)
  );

  messages: array[1..6, 1..2] of Cardinal = (
    (WM_LBUTTONDOWN, RI_MOUSE_LEFT_BUTTON_DOWN),
    (WM_LBUTTONUP, RI_MOUSE_LEFT_BUTTON_UP),
    (WM_RBUTTONDOWN, RI_MOUSE_RIGHT_BUTTON_DOWN),
    (WM_RBUTTONUP, RI_MOUSE_RIGHT_BUTTON_UP),
    (WM_MBUTTONDOWN, RI_MOUSE_MIDDLE_BUTTON_DOWN),
    (WM_MBUTTONUP, RI_MOUSE_MIDDLE_BUTTON_UP)
  );

var
  lpb: PRawInput;
  dwSize: DWord;
  W: Word;
  i: Integer;
  skipMessage: Cardinal;
  cursorPos: TPoint;
begin
  if Lock then Exit;

  GetRawInputData(MSG.LParam, RID_INPUT, nil, dwSize,SizeOf(TRawInputHeader));
  GetMem(lpb, dwSize*SizeOf(TRawInputHeader));
  try
    GetRawInputData(MSG.LParam, RID_INPUT, lpb, dwSize, SizeOf(TRawInputHeader));
    case lpb.header.dwType of
      RIM_TYPEMOUSE:
        begin
          GetCursorPos(cursorPos);
          if (waitPoint.X <> 0) and (waitPoint.Y <> 0) then begin
            if (waitPoint.X = lpb.mouse.lLastX) or (waitPoint.Y = lpb.mouse.lLastY) then begin
              if IsEmpty(tempMove) then begin
                waitPoint := Point(0, 0);
              end else begin
                waitPoint := Point(waitPoint.X + tempMove.X, waitPoint.Y + tempMove.Y);
                tempMove := Point(0, 0);
                //mouse_event(MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE, waitPoint.X, waitPoint.Y, 0, 0);
              end;
            end;

            if (lpb.mouse.usFlags and MOUSE_MOVE_ABSOLUTE) = MOUSE_MOVE_ABSOLUTE  then
            else begin
              // only on relative move mouse
              tempMove.X := tempMove.X + (cursorPos.X - oldPos.X);
              tempMove.Y := tempMove.Y + (cursorPos.Y - oldPos.Y);
            end;
          end;
          oldPos := cursorPos;

          W := lpb.mouse.union.usButtonFlags;
          if FSkipList.Count > 0 then begin
            skipMessage := Cardinal(FSkipList[0]);
            for i := 1 to 6 do begin
              if (messages[i, 1] = skipMessage) and (messages[i, 2] = W) then begin
                FSkipList.Delete(0);
                W := 0;
                break;
              end;
            end;
          end;

          for i := 1 to 3 do begin
            if (W and buttons[i, bcMaskButtonDown]) = buttons[i, bcMaskButtonDown] then begin
              ButtonDown(buttons[i, bcVirtKey]);
              Break;
            end else
            if (W and buttons[i, bcMaskButtonUp]) = buttons[i, bcMaskButtonUp] then begin
              ButtonUp(buttons[i, bcVirtKey]);
              Break;
            end;
          end;
        end;
    end;
  finally
    FreeMem(lpb);
  end;
end;

procedure TMouseEvents.Open;
begin
  RAWInputDevice[0].usUsagePage := $0001;
  RAWInputDevice[0].usUsage     := $02;
  RAWInputDevice[0].dwFlags     := RIDEV_INPUTSINK;
  RAWInputDevice[0].hwndTarget  := Handle;
  RegisterRawInputDevices(@RAWInputDevice, 1, SizeOf(TRAWInputDevice));
end;

function TMouseEvents.SkipListCount: Integer;
begin
  Result := FSkipList.Count;
end;

end.
